home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / POSTFIX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-10  |  2.5 KB  |  94 lines
  1.  
  2. Program postfix;
  3. uses crt;
  4. const
  5.   maxstack = 100;
  6.  
  7. type
  8.   basetype = char;
  9.   stack = record
  10.           item : array[1..maxstack] of basetype;
  11.           top  : 0..maxstack;
  12.   end;
  13. var
  14.   i:Byte;
  15.   s:stack;
  16.   str:string;
  17.   operat_0,operat_1:Char;
  18.   underflow,overflow:boolean;
  19.   temporary_number:Byte;
  20. function empty(s:stack):boolean;
  21. begin
  22.  if s.top=0 then empty:=true
  23.             else empty:=false;
  24. end;
  25. procedure pop(var s:stack;var x:basetype;var underflow:boolean);
  26. begin
  27.   if empty(s) then underflow:=true
  28.     else begin
  29.            x:=s.item[s.top];
  30.            s.top :=s.top-1;
  31.            underflow:=false;
  32.          end;
  33. end;
  34. procedure push(var s:stack;x:basetype;var overflow:boolean);
  35. begin
  36.      If s.top>=maxstack then overflow:=true
  37.                         else begin
  38.                                overflow:=false;
  39.                                s.top:=s.top+1;
  40.                                s.item[s.top]:=x;
  41.                              end;
  42. end;
  43. Procedure error_occured;
  44. begin
  45.  writeln ('Geçersiz giriƒ yapìldì.');
  46.  writeln ('  Sistem halt etti!    ');
  47.  HALT;
  48. end;
  49.  
  50. begin
  51. textbackground(15);textcolor(0);
  52. repeat
  53.  ClrScr;
  54.  temporary_number:=1;
  55.  s.top:=0;
  56.  write ('Postfix ifadeyi giriniz...:');
  57.  readln(str);
  58.  If length(str)<1 then error_occured;
  59.   For i:=1 to length(str) do
  60.    if not (str[i] in ['a'..'z','A'..'Z','-','+','*','/'])then error_occured;
  61.   for i:=1 to length(str) do
  62.    begin
  63.     if str[i] in ['+','-','*','/'] then
  64.     begin
  65.        pop (s,operat_0,underflow);
  66.        if underflow then error_occured;
  67.        pop (s,operat_1,underflow);
  68.        if underflow then error_occured;
  69.        write ('LD ');
  70.        if operat_1<'A' then writeln ('TEMP_',ord(operat_1))
  71.        else writeln (operat_1);
  72.        case str[i] of
  73.        '+' : write ('ADD ');
  74.        '-' : write ('SUB ');
  75.        '*' : write ('MUL ');
  76.        '/' : write ('DIV ');
  77.      end;
  78.          if operat_0<'A' then writeln ('TEMP_',ord(operat_0))
  79.          else writeln (operat_0);
  80.          push (s,chr(temporary_number),overflow);
  81.          if (overflow) then error_occured;
  82.          writeln ('ST TEMP_',ord(temporary_number));
  83.          temporary_number:=temporary_number+1;
  84.          end
  85.          else begin
  86.          push (s,str[i],overflow);
  87.          if (overflow) then error_occured;
  88.         end;
  89.    end;
  90.  writeln('ÿfade deºerlendirildi, kod üretildi...');
  91.  writeln('Çìkmak için X'e , devam için herhangi bir tuƒa basìnìz.');
  92. until (readKey='X') or (readKey='x');
  93. end.
  94.